home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tk8.0 / entry.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  15.0 KB  |  612 lines
  1. # entry.tcl --
  2. #
  3. # This file defines the default bindings for Tk entry widgets and provides
  4. # procedures that help in implementing those bindings.
  5. #
  6. # SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # mouseMoved -        Non-zero means the mouse has moved a significant
  22. #            amount since the button went down (so, for example,
  23. #            start dragging out a selection).
  24. # pressX -        X-coordinate at which the mouse button was pressed.
  25. # selectMode -        The style of selection currently underway:
  26. #            char, word, or line.
  27. # x, y -        Last known mouse coordinates for scanning
  28. #            and auto-scanning.
  29. #-------------------------------------------------------------------------
  30.  
  31. #-------------------------------------------------------------------------
  32. # The code below creates the default class bindings for entries.
  33. #-------------------------------------------------------------------------
  34.  
  35. bind Entry <<Cut>> {
  36.     if {![catch {set data [string range [%W get] [%W index sel.first]\
  37.          [expr [%W index sel.last] - 1]]}]} {
  38.     clipboard clear -displayof %W
  39.     clipboard append -displayof %W $data
  40.     %W delete sel.first sel.last
  41.     }
  42. }
  43. bind Entry <<Copy>> {
  44.     if {![catch {set data [string range [%W get] [%W index sel.first]\
  45.          [expr [%W index sel.last] - 1]]}]} {
  46.     clipboard clear -displayof %W
  47.     clipboard append -displayof %W $data
  48.     }
  49. }
  50. bind Entry <<Paste>> {
  51.     global tcl_platform
  52.     catch {
  53.     if {"$tcl_platform(platform)" != "unix"} {
  54.         catch {
  55.         %W delete sel.first sel.last
  56.         }
  57.     }
  58.     %W insert insert [selection get -displayof %W -selection CLIPBOARD]
  59.     tkEntrySeeInsert %W
  60.     }
  61. }
  62. bind Entry <<Clear>> {
  63.     %W delete sel.first sel.last
  64. }
  65.  
  66. # Standard Motif bindings:
  67.  
  68. bind Entry <1> {
  69.     tkEntryButton1 %W %x
  70.     %W selection clear
  71. }
  72. bind Entry <B1-Motion> {
  73.     set tkPriv(x) %x
  74.     tkEntryMouseSelect %W %x
  75. }
  76. bind Entry <Double-1> {
  77.     set tkPriv(selectMode) word
  78.     tkEntryMouseSelect %W %x
  79.     catch {%W icursor sel.first}
  80. }
  81. bind Entry <Triple-1> {
  82.     set tkPriv(selectMode) line
  83.     tkEntryMouseSelect %W %x
  84.     %W icursor 0
  85. }
  86. bind Entry <Shift-1> {
  87.     set tkPriv(selectMode) char
  88.     %W selection adjust @%x
  89. }
  90. bind Entry <Double-Shift-1>    {
  91.     set tkPriv(selectMode) word
  92.     tkEntryMouseSelect %W %x
  93. }
  94. bind Entry <Triple-Shift-1>    {
  95.     set tkPriv(selectMode) line
  96.     tkEntryMouseSelect %W %x
  97. }
  98. bind Entry <B1-Leave> {
  99.     set tkPriv(x) %x
  100.     tkEntryAutoScan %W
  101. }
  102. bind Entry <B1-Enter> {
  103.     tkCancelRepeat
  104. }
  105. bind Entry <ButtonRelease-1> {
  106.     tkCancelRepeat
  107. }
  108. bind Entry <Control-1> {
  109.     %W icursor @%x
  110. }
  111. bind Entry <ButtonRelease-2> {
  112.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  113.     tkEntryPaste %W %x
  114.     }
  115. }
  116.  
  117. bind Entry <Left> {
  118.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  119. }
  120. bind Entry <Right> {
  121.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  122. }
  123. bind Entry <Shift-Left> {
  124.     tkEntryKeySelect %W [expr [%W index insert] - 1]
  125.     tkEntrySeeInsert %W
  126. }
  127. bind Entry <Shift-Right> {
  128.     tkEntryKeySelect %W [expr [%W index insert] + 1]
  129.     tkEntrySeeInsert %W
  130. }
  131. bind Entry <Control-Left> {
  132.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  133. }
  134. bind Entry <Control-Right> {
  135.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  136. }
  137. bind Entry <Shift-Control-Left> {
  138.     tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
  139.     tkEntrySeeInsert %W
  140. }
  141. bind Entry <Shift-Control-Right> {
  142.     tkEntryKeySelect %W [tkEntryNextWord %W insert]
  143.     tkEntrySeeInsert %W
  144. }
  145. bind Entry <Home> {
  146.     tkEntrySetCursor %W 0
  147. }
  148. bind Entry <Shift-Home> {
  149.     tkEntryKeySelect %W 0
  150.     tkEntrySeeInsert %W
  151. }
  152. bind Entry <End> {
  153.     tkEntrySetCursor %W end
  154. }
  155. bind Entry <Shift-End> {
  156.     tkEntryKeySelect %W end
  157.     tkEntrySeeInsert %W
  158. }
  159.  
  160. bind Entry <Delete> {
  161.     if [%W selection present] {
  162.     %W delete sel.first sel.last
  163.     } else {
  164.     %W delete insert
  165.     }
  166. }
  167. bind Entry <BackSpace> {
  168.     tkEntryBackspace %W
  169. }
  170.  
  171. bind Entry <Control-space> {
  172.     %W selection from insert
  173. }
  174. bind Entry <Select> {
  175.     %W selection from insert
  176. }
  177. bind Entry <Control-Shift-space> {
  178.     %W selection adjust insert
  179. }
  180. bind Entry <Shift-Select> {
  181.     %W selection adjust insert
  182. }
  183. bind Entry <Control-slash> {
  184.     %W selection range 0 end
  185. }
  186. bind Entry <Control-backslash> {
  187.     %W selection clear
  188. }
  189. bind Entry <KeyPress> {
  190.     tkEntryInsert %W %A
  191. }
  192.  
  193. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  194. # Otherwise, if a widget binding for one of these is defined, the
  195. # <KeyPress> class binding will also fire and insert the character,
  196. # which is wrong.  Ditto for Escape, Return, and Tab.
  197.  
  198. bind Entry <Alt-KeyPress> {# nothing}
  199. bind Entry <Meta-KeyPress> {# nothing}
  200. bind Entry <Control-KeyPress> {# nothing}
  201. bind Entry <Escape> {# nothing}
  202. bind Entry <Return> {# nothing}
  203. bind Entry <KP_Enter> {# nothing}
  204. bind Entry <Tab> {# nothing}
  205. if {$tcl_platform(platform) == "macintosh"} {
  206.     bind Entry <Command-KeyPress> {# nothing}
  207. }
  208.  
  209. # CYGNUS LOCAL: On Windows, Shift-Insert does this.  And Shift-Insert
  210. # generates the <<Paste>> event -- so we need do nothing.
  211. if {$tcl_platform(platform) != "windows"} {
  212.   bind Entry <Insert> {
  213.     catch {tkEntryInsert %W [selection get -displayof %W]}
  214.   }
  215. }
  216.  
  217. # Additional emacs-like bindings:
  218.  
  219. bind Entry <Control-a> {
  220.     if !$tk_strictMotif {
  221.     tkEntrySetCursor %W 0
  222.     }
  223. }
  224. bind Entry <Control-b> {
  225.     if !$tk_strictMotif {
  226.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  227.     }
  228. }
  229. bind Entry <Control-d> {
  230.     if !$tk_strictMotif {
  231.     %W delete insert
  232.     }
  233. }
  234. bind Entry <Control-e> {
  235.     if !$tk_strictMotif {
  236.     tkEntrySetCursor %W end
  237.     }
  238. }
  239. bind Entry <Control-f> {
  240.     if !$tk_strictMotif {
  241.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  242.     }
  243. }
  244. bind Entry <Control-h> {
  245.     if !$tk_strictMotif {
  246.     tkEntryBackspace %W
  247.     }
  248. }
  249. bind Entry <Control-k> {
  250.     if !$tk_strictMotif {
  251.     %W delete insert end
  252.     }
  253. }
  254. bind Entry <Control-t> {
  255.     if !$tk_strictMotif {
  256.     tkEntryTranspose %W
  257.     }
  258. }
  259. bind Entry <Meta-b> {
  260.     if !$tk_strictMotif {
  261.     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
  262.     }
  263. }
  264. bind Entry <Meta-d> {
  265.     if !$tk_strictMotif {
  266.     %W delete insert [tkEntryNextWord %W insert]
  267.     }
  268. }
  269. bind Entry <Meta-f> {
  270.     if !$tk_strictMotif {
  271.     tkEntrySetCursor %W [tkEntryNextWord %W insert]
  272.     }
  273. }
  274. bind Entry <Meta-BackSpace> {
  275.     if !$tk_strictMotif {
  276.     %W delete [tkEntryPreviousWord %W insert] insert
  277.     }
  278. }
  279. bind Entry <Meta-Delete> {
  280.     if !$tk_strictMotif {
  281.     %W delete [tkEntryPreviousWord %W insert] insert
  282.     }
  283. }
  284.  
  285. # A few additional bindings of my own.
  286.  
  287. bind Entry <2> {
  288.     if !$tk_strictMotif {
  289.     %W scan mark %x
  290.     set tkPriv(x) %x
  291.     set tkPriv(y) %y
  292.     set tkPriv(mouseMoved) 0
  293.     }
  294. }
  295. bind Entry <B2-Motion> {
  296.     if !$tk_strictMotif {
  297.     if {abs(%x-$tkPriv(x)) > 2} {
  298.         set tkPriv(mouseMoved) 1
  299.     }
  300.     %W scan dragto %x
  301.     }
  302. }
  303.  
  304. # tkEntryClosestGap --
  305. # Given x and y coordinates, this procedure finds the closest boundary
  306. # between characters to the given coordinates and returns the index
  307. # of the character just after the boundary.
  308. #
  309. # Arguments:
  310. # w -        The entry window.
  311. # x -        X-coordinate within the window.
  312.  
  313. proc tkEntryClosestGap {w x} {
  314.     set pos [$w index @$x]
  315.     set bbox [$w bbox $pos]
  316.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  317.     return $pos
  318.     }
  319.     incr pos
  320. }
  321.  
  322. # tkEntryButton1 --
  323. # This procedure is invoked to handle button-1 presses in entry
  324. # widgets.  It moves the insertion cursor, sets the selection anchor,
  325. # and claims the input focus.
  326. #
  327. # Arguments:
  328. # w -        The entry window in which the button was pressed.
  329. # x -        The x-coordinate of the button press.
  330.  
  331. proc tkEntryButton1 {w x} {
  332.     global tkPriv
  333.  
  334.     set tkPriv(selectMode) char
  335.     set tkPriv(mouseMoved) 0
  336.     set tkPriv(pressX) $x
  337.     $w icursor [tkEntryClosestGap $w $x]
  338.     $w selection from insert
  339.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  340. }
  341.  
  342. # tkEntryMouseSelect --
  343. # This procedure is invoked when dragging out a selection with
  344. # the mouse.  Depending on the selection mode (character, word,
  345. # line) it selects in different-sized units.  This procedure
  346. # ignores mouse motions initially until the mouse has moved from
  347. # one character to another or until there have been multiple clicks.
  348. #
  349. # Arguments:
  350. # w -        The entry window in which the button was pressed.
  351. # x -        The x-coordinate of the mouse.
  352.  
  353. proc tkEntryMouseSelect {w x} {
  354.     global tkPriv
  355.  
  356.     set cur [tkEntryClosestGap $w $x]
  357.     set anchor [$w index anchor]
  358.     if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
  359.     set tkPriv(mouseMoved) 1
  360.     }
  361.     switch $tkPriv(selectMode) {
  362.     char {
  363.         if $tkPriv(mouseMoved) {
  364.         if {$cur < $anchor} {
  365.             $w selection range $cur $anchor
  366.         } elseif {$cur > $anchor} {
  367.             $w selection range $anchor $cur
  368.         } else {
  369.             $w selection clear
  370.         }
  371.         }
  372.     }
  373.     word {
  374.         if {$cur < [$w index anchor]} {
  375.         set before [tcl_wordBreakBefore [$w get] $cur]
  376.         set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]]
  377.         } else {
  378.         set before [tcl_wordBreakBefore [$w get] $anchor]
  379.         set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]]
  380.         }
  381.         if {$before < 0} {
  382.         set before 0
  383.         }
  384.         if {$after < 0} {
  385.         set after end
  386.         }
  387.         $w selection range $before $after
  388.     }
  389.     line {
  390.         $w selection range 0 end
  391.     }
  392.     }
  393.     update idletasks
  394. }
  395.  
  396. # tkEntryPaste --
  397. # This procedure sets the insertion cursor to the current mouse position,
  398. # pastes the selection there, and sets the focus to the window.
  399. #
  400. # Arguments:
  401. # w -        The entry window.
  402. # x -        X position of the mouse.
  403.  
  404. proc tkEntryPaste {w x} {
  405.     global tkPriv
  406.  
  407.     $w icursor [tkEntryClosestGap $w $x]
  408.     catch {$w insert insert [selection get -displayof $w]}
  409.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  410. }
  411.  
  412. # tkEntryAutoScan --
  413. # This procedure is invoked when the mouse leaves an entry window
  414. # with button 1 down.  It scrolls the window left or right,
  415. # depending on where the mouse is, and reschedules itself as an
  416. # "after" command so that the window continues to scroll until the
  417. # mouse moves back into the window or the mouse button is released.
  418. #
  419. # Arguments:
  420. # w -        The entry window.
  421.  
  422. proc tkEntryAutoScan {w} {
  423.     global tkPriv
  424.     set x $tkPriv(x)
  425.     if {![winfo exists $w]} return
  426.     if {$x >= [winfo width $w]} {
  427.     $w xview scroll 2 units
  428.     tkEntryMouseSelect $w $x
  429.     } elseif {$x < 0} {
  430.     $w xview scroll -2 units
  431.     tkEntryMouseSelect $w $x
  432.     }
  433.     set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
  434. }
  435.  
  436. # tkEntryKeySelect --
  437. # This procedure is invoked when stroking out selections using the
  438. # keyboard.  It moves the cursor to a new position, then extends
  439. # the selection to that position.
  440. #
  441. # Arguments:
  442. # w -        The entry window.
  443. # new -        A new position for the insertion cursor (the cursor hasn't
  444. #        actually been moved to this position yet).
  445.  
  446. proc tkEntryKeySelect {w new} {
  447.     if ![$w selection present] {
  448.     $w selection from insert
  449.     $w selection to $new
  450.     } else {
  451.     $w selection adjust $new
  452.     }
  453.     $w icursor $new
  454. }
  455.  
  456. # tkEntryInsert --
  457. # Insert a string into an entry at the point of the insertion cursor.
  458. # If there is a selection in the entry, and it covers the point of the
  459. # insertion cursor, then delete the selection before inserting.
  460. #
  461. # Arguments:
  462. # w -        The entry window in which to insert the string
  463. # s -        The string to insert (usually just a single character)
  464.  
  465. proc tkEntryInsert {w s} {
  466.     if {$s == ""} {
  467.     return
  468.     }
  469.     catch {
  470.     set insert [$w index insert]
  471.     if {([$w index sel.first] <= $insert)
  472.         && ([$w index sel.last] >= $insert)} {
  473.         $w delete sel.first sel.last
  474.     }
  475.     }
  476.     $w insert insert $s
  477.     tkEntrySeeInsert $w
  478. }
  479.  
  480. # tkEntryBackspace --
  481. # Backspace over the character just before the insertion cursor.
  482. # If backspacing would move the cursor off the left edge of the
  483. # window, reposition the cursor at about the middle of the window.
  484. #
  485. # Arguments:
  486. # w -        The entry window in which to backspace.
  487.  
  488. proc tkEntryBackspace w {
  489.     if [$w selection present] {
  490.     $w delete sel.first sel.last
  491.     } else {
  492.     set x [expr {[$w index insert] - 1}]
  493.     if {$x >= 0} {$w delete $x}
  494.     if {[$w index @0] >= [$w index insert]} {
  495.         set range [$w xview]
  496.         set left [lindex $range 0]
  497.         set right [lindex $range 1]
  498.         $w xview moveto [expr $left - ($right - $left)/2.0]
  499.     }
  500.     }
  501. }
  502.  
  503. # tkEntrySeeInsert --
  504. # Make sure that the insertion cursor is visible in the entry window.
  505. # If not, adjust the view so that it is.
  506. #
  507. # Arguments:
  508. # w -        The entry window.
  509.  
  510. proc tkEntrySeeInsert w {
  511.     set c [$w index insert]
  512.     set left [$w index @0]
  513.     if {$left > $c} {
  514.     $w xview $c
  515.     return
  516.     }
  517.     set x [winfo width $w]
  518.     while {([$w index @$x] <= $c) && ($left < $c)} {
  519.     incr left
  520.     $w xview $left
  521.     }
  522. }
  523.  
  524. # tkEntrySetCursor -
  525. # Move the insertion cursor to a given position in an entry.  Also
  526. # clears the selection, if there is one in the entry, and makes sure
  527. # that the insertion cursor is visible.
  528. #
  529. # Arguments:
  530. # w -        The entry window.
  531. # pos -        The desired new position for the cursor in the window.
  532.  
  533. proc tkEntrySetCursor {w pos} {
  534.     $w icursor $pos
  535.     $w selection clear
  536.     tkEntrySeeInsert $w
  537. }
  538.  
  539. # tkEntryTranspose -
  540. # This procedure implements the "transpose" function for entry widgets.
  541. # It tranposes the characters on either side of the insertion cursor,
  542. # unless the cursor is at the end of the line.  In this case it
  543. # transposes the two characters to the left of the cursor.  In either
  544. # case, the cursor ends up to the right of the transposed characters.
  545. #
  546. # Arguments:
  547. # w -        The entry window.
  548.  
  549. proc tkEntryTranspose w {
  550.     set i [$w index insert]
  551.     if {$i < [$w index end]} {
  552.     incr i
  553.     }
  554.     set first [expr $i-2]
  555.     if {$first < 0} {
  556.     return
  557.     }
  558.     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
  559.     $w delete $first $i
  560.     $w insert insert $new
  561.     tkEntrySeeInsert $w
  562. }
  563.  
  564. # tkEntryNextWord --
  565. # Returns the index of the next word position after a given position in the
  566. # entry.  The next word is platform dependent and may be either the next
  567. # end-of-word position or the next start-of-word position after the next
  568. # end-of-word position.
  569. #
  570. # Arguments:
  571. # w -        The entry window in which the cursor is to move.
  572. # start -    Position at which to start search.
  573.  
  574. if {$tcl_platform(platform) == "windows"}  {
  575.     proc tkEntryNextWord {w start} {
  576.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  577.     if {$pos >= 0} {
  578.         set pos [tcl_startOfNextWord [$w get] $pos]
  579.     }
  580.     if {$pos < 0} {
  581.         return end
  582.     }
  583.     return $pos
  584.     }
  585. } else {
  586.     proc tkEntryNextWord {w start} {
  587.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  588.     if {$pos < 0} {
  589.         return end
  590.     }
  591.     return $pos
  592.     }
  593. }
  594.  
  595. # tkEntryPreviousWord --
  596. #
  597. # Returns the index of the previous word position before a given
  598. # position in the entry.
  599. #
  600. # Arguments:
  601. # w -        The entry window in which the cursor is to move.
  602. # start -    Position at which to start search.
  603.  
  604. proc tkEntryPreviousWord {w start} {
  605.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  606.     if {$pos < 0} {
  607.     return 0
  608.     }
  609.     return $pos
  610. }
  611.  
  612.